home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / src-server / w_savedobjs.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-05  |  4.6 KB  |  111 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         w_savedobjs.c
  5. * RCS:          $Header: w_savedobjs.c,v 1.3 91/03/14 03:14:12 mayer Exp $
  6. * Description:  Hashtable of LVAL's to be protected against garbage coll.
  7. * Author:       Niels Mayer, HPLabs
  8. * Created:      Sun Sep 24 22:31:43 1989
  9. * Modified:     Fri Oct  4 20:18:15 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. **
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: w_savedobjs.c,v 1.3 91/03/14 03:14:12 mayer Exp $";
  43.  
  44. #include <stdio.h>
  45. #include <Xm/Xm.h>        /* Xm/Xm.h only needed for "winterp.h"*/
  46. #include "winterp.h"
  47. #include "user_prefs.h"
  48. #include "xlisp/xlisp.h"
  49.  
  50. /*
  51.   We put an initializer for LVAL v_savedobjs in xlsym:xlsinit(), and add
  52.   this to the list of structures that gets marked by gc. v_savedobjs is a
  53.   hashtable for storing LVAL's that need to persist across garbage
  54.   collections.
  55.  
  56.   v_savedobjs is typically used for storing callback-objects,
  57.   timeout-objects, etc.  These objects need to persist even though they are
  58.   not directly referenced by any user-space global variables because a
  59.   callback or timout may occur at any time and we must not allow the code or
  60.   lexical environment associated with one of these delayed calls to be gc'd.
  61.  
  62.   v_savedobjs is used to store LVAL's. The hash function removes the bits
  63.   from the LVAL address used for adressing within the LVAL (i.e. rightshift
  64.   by the # of bits in an LVAL struct. Then we take that value modulo
  65.   VSAVEDOBJS_SIZE to come up with the index into the hashtable.
  66. */
  67.  
  68. #define HASHTAB_ADDR_MASK 0xffL    /* value must be (2^x - 1) for any x */
  69. #define HASHTAB_SIZE ((int) HASHTAB_ADDR_MASK + 1)
  70. static int LVAL_ADDRESS_WIDTH;    /* must be initialized by Wso_Init(). */
  71.  
  72. /******************************************************************************
  73.  * Given an LVAL, returns the hash index into v_savedobjs for that object.
  74.  * This is done quite sleazily/simply by using the adress of the lisp object
  75.  * right shifted by the number of bits used to index inside a LVAL structure
  76.  * Then masked by the size of the power-of-2-sized hashtable. The result is
  77.  * a value ranging from 0 to HASH_MASK.
  78.  ******************************************************************************/
  79. int Wso_Hash(object)
  80.      LVAL object;
  81. {
  82.   unsigned long i;
  83.   i = ((unsigned long) object >> LVAL_ADDRESS_WIDTH) & HASHTAB_ADDR_MASK;
  84.   return ((int) i);
  85. }
  86.  
  87.  
  88. /******************************************************************************
  89.  *
  90.  ******************************************************************************/
  91. Wso_Init()
  92. {
  93.   extern LVAL v_savedobjs;    /* xlglob.c */
  94.   int i;
  95.   LVAL sym;
  96.  
  97.   /* compute the number of bits used to index within an LVAL structure */
  98.   i = sizeof(struct node);    /* size of an LVAL* in bytes */
  99.   LVAL_ADDRESS_WIDTH = 1;
  100.   while (i >= 2) {
  101.     i /= 2;
  102.     ++LVAL_ADDRESS_WIDTH;
  103.   }
  104.  
  105.   sym = xlenter("*SAVED_OBJS*");
  106.   v_savedobjs = newvector(HASHTAB_SIZE);
  107.   setvalue(sym, v_savedobjs); /* allow lisp access to v_savedobjs for debugging */
  108. }
  109.  
  110.  
  111.